(FILECREATED " 1-NOV-73 19:27:23" S-DRAW)


  (LISPXPRINT (QUOTE DRAWVARS)
              T)
  (RPAQQ DRAWVARS
         ((* All I/O routines have been moved here)
          (FNS DRAW PRINN DRAWS GENLET PRINRAD NUMNODES PRINRAD1 
               PRINCTAB PRINRAD0 PRINENTRY PRINRADOFF)
          (VARS STRUCNUM (DRAWFORK)
                GFILE)
          (USERMACROS DL DRAWS DRAW)))

(* All I/O routines have been moved here)

(DEFINEQ

(DRAW
  [LAMBDA (STRUC RAD)

          (* The rad flag is used when struc is not a 
          STRUCTURE. In this case it is either : T meaning 
          this is a RADICAL -
          L meaning this is a list of radicals -
          Al meaning this is an alist of 
          (id . struc))


    (PROG (O CTAB)
          [SETQ O (OUTPUT (OUTFILE (QUOTE FOR01.DAT;T]
          [RESETFORM
            (OUTPUT O)
            (PROG NIL
              LP  (COND
                    ((NULL STRUC)
                      (RETURN))
                    ((STRUCTURE? STRUC)
                      (DRAWS STRUC))
                    ((RADICAL? STRUC)
                      (PRINRAD STRUC))
                    ((STRUCTURE? (CAR STRUC))
                      (DRAWS (CAR STRUC)
                             NIL)
                      (SETQ STRUC (CDR STRUC))
                      (GO LP))
                    ((RADICAL? (CAR STRUC))
                      (PRINRAD (CAR STRUC))
                      (SETQ STRUC (CDR STRUC))
                      (GO LP))
                    [(EQ RAD (QUOTE AL))
                      (MAPC STRUC
                            (FUNCTION (LAMBDA (S)
                                (COND
                                  [(STRUCTURE? (CDR S))
                                    (DRAWS (CDR S)
                                           (LIST (QUOTE structure)
                                                 (QUOTE #)
                                                 (CAR S]
                                  [(RADICAL? (CDR S))
                                    (PRINRAD
                                      (CDR S)
                                      NIL
                                      (LIST (CONS "Structure #"
                                                  (CAR S]
                                  (T (ERROR "BAD INPUT TO DRAW:" S]
                    (T (CLOSEF O)
                       (ERROR!]
          (CLOSEF O)
          (OR [CAR (NLSETQ (AND DRAWFORK (SUBSYS DRAWFORK NIL NIL
                                                 (QUOTE START]
              (SETQ DRAWFORK (SUBSYS (QUOTE DRAW])

(PRINN
  [LAMBDA (N L)
    (SPACES (IDIFFERENCE L (NCHARS N)))
    (PRIN1 N])

(DRAWS
  [LAMBDA (STRUC ID)
    (PROG (CTAB)
          (SETQ XLATETAB NIL)
          (SETQ CTAB (FETCH CTABLE OF STRUC))
          (PRINN (LENGTH CTAB)
                 5)
          (TERPRI)
          [MAPC CTAB (FUNCTION (LAMBDA (CTE)
                    (PRINENTRY (FETCH NODENUM OF CTE)
                               (FETCH ATOMTYPE OF
                                      (FETCH MARKERS OF CTE))
                               (FETCH NBRS OF CTE]
          (PRIN1 " ")
          (PRINT (OR ID (FETCH UGRAPH OF STRUC)))
          [COND
            (XLATETAB (FOR PR IN XLATETAB DO (SPACES 1)
                                             (PRIN1 (CAR PR))
                                             (PRIN1 " = ")
                                             (PRINT (CDR PR]
          (PRINT (QUOTE END*])

(GENLET
  [LAMBDA (AT)
    (OR (FOR PR IN XLATETAB ISSOME (AND (EQUAL AT (CDR PR))
                                        (CAR PR)))
        (CAAR (SETQ XLATETAB
                (CONS (CONS (FOR LET
                               IN (QUOTE (X Y Z W # & ← ≠
                                            ! , ? V U T R Q P M L K J I 
                                            G F E D B A N O C H))
                               SUCHTHAT (NOT (ASSOC LET XLATETAB)))
                            AT)
                      XLATETAB])

(PRINRAD
  [LAMBDA (L XLATETAB TITLE)
    (PROG (N)
          (SETQ N (NUMNODES L))
          (PRINN N 5)
          (TERPRI)
          (PRINRAD1 NIL (FOR I TO N COLLECT I)
                    L)
          (PRINRADOFF])

(NUMNODES
  [LAMBDA (RAD)
    (IPLUS [FOR R IN (FETCH ATTACHEDRADS OF RAD)
              SUM (ITIMES (CDR R)
                          (NUMNODES (CAR R]
           (COND
             ((NULL (FETCH CENTER OF RAD))
               0)
             ((ATOM (FETCH CENTER OF RAD))
               1)
             ([NOT (STRUCTURE? (FETCH RADSTRUC OF
                                      (FETCH CENTER OF RAD]
               1)
             (T (LENGTH (NODES (FETCH RADSTRUC OF
                                      (FETCH CENTER OF RAD])

(PRINRAD1
  [LAMBDA (EFF AA RAD)
    (PROG (CENT ATTACHED J X TTABLE)
          (SETQ CENT (FETCH CENTER OF RAD))
          (SETQ ATTACHED (CLEXPAND (FETCH ATTACHEDRADS OF RAD)))
          (RETURN (COND
                    ((NOT CENT)
                      (PRINRAD1 (CADR AA)
                                (CONS (CAR AA)
                                      (PRINRAD1 (CAR AA)
                                                (CDR AA)
                                                (CAR ATTACHED)))
                                (CADR ATTACHED)))
                    ([OR (ATOM CENT)
                         (NOT (STRUCTURE? (FETCH RADSTRUC OF CENT]
                      (SETQ X (CDR AA))
                      (FOR R IN ATTACHED DO (SETQ J
                                              (CONS (CAR X)
                                                    J))
                                            (SETQ X
                                              (PRINRAD1 (CAR AA)
                                                        X R)))
                      (PRINENTRY (CAR AA)
                                 CENT
                                 (COND
                                   (EFF (CONS EFF J))
                                   (T J)))
                      X)
                    (T [SETQ X
                         (COND
                           ((NOT EFF)
                             AA)
                           (T (SETQ TTABLE
                                (LIST (LIST (FETCH AFFLINK OF CENT)
                                            (CAR AA)
                                            EFF)))
                              (CDR AA]
                       (FOR N IN (NODES (FETCH RADSTRUC OF CENT))
                          WHEN (NOT (EQUAL N (FETCH AFFLINK OF CENT)))
                          DO (SETQ TTABLE (CONS (LIST N (CAR X))
                                                TTABLE))
                             (SETQ X (CDR X)))
                       (FOR NLIST IN (FETCH CUFFLINKS OF CENT)
                                    FOR C
                          IN NLIST
                          AS CT IS (LMASSOC C TTABLE NIL)
                          DO (NCONC1 CT (CAR X))
                             (SETQ X (PRINRAD1 (CAR CT)
                                               X
                                               (CAR ATTACHED)))
                             (SETQ ATTACHED (CDR ATTACHED)))
                       (PRINCTAB (FETCH CTABLE OF
                                        (FETCH RADSTRUC OF CENT))
                                 TTABLE)
                       X])

(PRINCTAB
  [LAMBDA (CTAB TTABLE)
    (FOR CT IN CTAB AS CPRIME IS (LMASSOC (FETCH NODENUM OF CT)
                                          TTABLE NIL)
       DO (PRINENTRY (CAR CPRIME)
                     (FETCH ATOMTYPE OF (FETCH MARKERS OF CT))
                     (APPEND (CDR CPRIME)
                             (FOR Y IN (FETCH NBRS OF CT)
                                WHEN (NOT (EQ Y (QUOTE FV)))
                                     XLIST
                                     (CAR (LMASSOC Y TTABLE NIL])

(PRINRAD0
  [LAMBDA (L)
    (PRINN L 3])

(PRINENTRY
  [LAMBDA (N AT CON)
    (PRINN N 3)
    (PRIN1 " ")
    [PRIN1 (COND
             ((EQ 1 (NCHARS AT))
               AT)
             ((NOT AT)
               (FOR X IN CON WHEN (EQ X (QUOTE FV)) SUM 1))
             (T (GENLET AT]
    (TAB 6)
    [MAPC CON (FUNCTION (LAMBDA (X)
              (OR (EQ X (QUOTE FV))
                  (PRINN X 3]
    (TERPRI])

(PRINRADOFF
  [LAMBDA (L)
    (TERPRI)
    (AND TITLE (PRINT TITLE))
    [COND
      (XLATETAB (FOR PR IN XLATETAB DO (SPACES 1)
                                       (PRIN1 (CAR PR))
                                       (PRIN1 " = ")
                                       (PRINT (CDR PR]
    (PRINT (QUOTE END*])
)
  (RPAQQ STRUCNUM 1)
  (RPAQ DRAWFORK)
  (RPAQQ GFILE T)
  [ADDTOVAR USERMACROS
            [DL NIL (IF (STRUCTURE? (##))
                        ((E (DRAW (##))
                            T))
                        ((IF (STRUCLIST? (##))
                             ((E (DRAW (CDDR (##))
                                       (QUOTE L))
                                 T))
                             ((IF (STRUCFORM? (##))
                                  ((E (QUOTE CAN'T)))
                                  ((E (DRAW (##)
                                            T)
                                      T]
            [DRAWS X (E (DRAW (## . X]
            (DRAW X (E (DRAW (## . X)
                             T]
  (ADDTOVAR EDITCOMSA DL)
  (ADDTOVAR EDITCOMSL DRAW DRAWS)
STOP